home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / LISTS.I < prev    next >
Encoding:
Modula Implementation  |  1990-10-24  |  17.9 KB  |  753 lines
  1. IMPLEMENTATION MODULE Lists; (* V#031 *)
  2. (*$Y+,R-,N-,H+*)
  3.  
  4. (*
  5.   Die gehören nach 'ListsBase':
  6.   -----------------------------
  7.         (*
  8.          * MOS-interne Funktionen
  9.          * ----------------------
  10.          *)
  11.         
  12.         TYPE LCarrRec = ARRAY [1..3] OF ADDRESS;
  13.         
  14.         PROCEDURE LinkIn ( VAR list: List; VAR carr: LCarrRec; entry: ADDRESS );
  15.           (*
  16.            * Wie 'InsertEntry'.
  17.            *)
  18.  
  19.         PROCEDURE LinkOut ( VAR list: List );
  20.           (*
  21.            * Wie 'RemoveEntry'.
  22.            *)
  23.  
  24. *)
  25.  
  26. (*
  27.  * Allgemeine Listenverwaltung.
  28.  *
  29.  * Nach 'ADTLists' aus: Dal Cin, Lutz, Risse: Programmierung in Modula-2.
  30.  *
  31.  * Erstellt 25.3.87, TT
  32.  *
  33.  * 27.08.88  TT  Bei 'releaseLevel' werden die Listen nun richtig freigegeben.
  34.  * 30.09.88  TT  Sys-Funktionen werden nicht autom. bei unterstem Level-Ende
  35.  *               abgemeldet.
  36.  * 25.10.88  TT  CatchRemoval-Aufruf
  37.  * 16.02.89  TT  create setzt 'level' nun korrekt (bisher wurde ein .L statt .W
  38.  *               Zugriff gemacht, was zufolge hatte, daß nachfolgender Speicher
  39.  *               überschrieben wurde.
  40.  *)
  41.  
  42. FROM SYSTEM IMPORT ASSEMBLER;
  43. FROM SYSTEM IMPORT ADDRESS, LONGWORD, ADR, TSIZE;
  44.  
  45. FROM Storage IMPORT DEALLOCATE;
  46.  
  47. FROM ResCtrl IMPORT RemovalCarrier, CatchRemoval;
  48.  
  49. IMPORT PrgCtrl, Storage, MOSGlobals;
  50.  
  51. TYPE    LCarrier = POINTER TO Carrier;
  52.         Carrier  = RECORD
  53.                      next, prev: LCarrier;
  54.                      data: ADDRESS
  55.                    END;
  56.         
  57.         P_Control= POINTER TO Control;
  58.         Control  = RECORD
  59.                      next,prev: P_Control;
  60.                      owner: LCarrier;
  61.                      level: INTEGER
  62.                    END;
  63. (*
  64.         List = RECORD
  65.                  root, current: LCarrier
  66.                END;
  67.  
  68.         LCondProc = PROCEDURE ( ADDRESS ): BOOLEAN;
  69.  
  70.         LDir = ( frwd, back );
  71. *)
  72.  
  73. VAR LRoot: Control;
  74.     Level: INTEGER;
  75.  
  76. PROCEDURE SysAlloc (VAR ad:LONGWORD; l:LONGCARD);
  77.   (*$L-*)
  78.   BEGIN
  79.     ASSEMBLER
  80.       JMP Storage.SysAlloc
  81.     END
  82.   END SysAlloc;
  83.   (*$L=*)
  84.  
  85. (*
  86. PROCEDURE LinkIn ( VAR list: List; VAR carr: LCarrRec; entry: ADDRESS );
  87.   (*$L-*)
  88.   BEGIN
  89.     ASSEMBLER
  90.         MOVE.L  -(A3),D2        ; entry
  91.         MOVE.L  -(A3),A1        ; carr: A1
  92.         MOVE.L  -(A3),A0        ; list: A0
  93.         TST.L   List.root(A0)
  94.         BEQ     ende
  95.         
  96.         MOVE.L  List.current(A0),A2
  97.         MOVE.L  A1,List.current(A0)
  98.         
  99.         MOVE.L  Carrier.next(A2),A0     ; current^.next
  100.         MOVE.L  A0,Carrier.next(A1)
  101.         MOVE.L  A2,Carrier.prev(A1)
  102.         MOVE.L  D2,Carrier.data(A1)
  103.         
  104.         MOVE.L  A1,Carrier.prev(A0)
  105.         MOVE.L  A1,Carrier.next(A2)
  106.       ende:
  107.     END
  108.   END LinkIn;
  109.   (*$L=*)
  110.  
  111. PROCEDURE LinkOut ( VAR list: List );
  112.   (*$L-*)
  113.   BEGIN
  114.     ASSEMBLER
  115.         MOVE.L  -(A3),A0        ; list: A0
  116.         MOVE.L  List.root(A0),D0
  117.         BEQ     ende
  118.         MOVE.L  List.current(A0),A2
  119.         CMP.L   A2,D0
  120.         BEQ     ende
  121.         MOVE.L  Carrier.prev(A2),List.current(A0)
  122.         MOVE.L  Carrier.next(A2),A1
  123.         MOVE.L  Carrier.prev(A2),A0
  124.         MOVE.L  A0,Carrier.prev(A1)
  125.         MOVE.L  A1,Carrier.next(A0)
  126.       ende:
  127.     END
  128.   END LinkOut;
  129.   (*$L=*)
  130. *)
  131.  
  132. PROCEDURE InitList ( VAR l: List );
  133.   (*$L-*)
  134.   BEGIN
  135.     ASSEMBLER
  136.         MOVE.L  -(A3),A0
  137.         CLR.L   (A0)+
  138.         CLR.L   (A0)+
  139.         CLR.L   (A0)
  140.     END
  141.   END InitList;
  142.   (*$L=*)
  143.  
  144. PROCEDURE ResetList ( VAR list: List );
  145.   (*$L-*)
  146.   BEGIN
  147.     (*
  148.        WITH list DO
  149.          current:= root
  150.        END
  151.     *)
  152.     ASSEMBLER
  153.         MOVE.L  -(A3),A0
  154.         MOVE.L  List.root(A0),List.current(A0)
  155.     END
  156.   END ResetList;
  157.   (*$L=*)
  158.  
  159. PROCEDURE create ( VAR list: List; VAR error: BOOLEAN; lev: INTEGER );
  160.   VAR p:P_Control;
  161.   BEGIN
  162.     SysAlloc (p,SIZE (p^));
  163.     SysAlloc (list.root,SIZE (list.root^));
  164.     error:= (list.root=NIL) OR (p=NIL);
  165.     IF error THEN
  166.       DISPOSE (p);
  167.       DISPOSE (list.root)
  168.     ELSE
  169.       (*
  170.         WITH p^ DO
  171.           next:= LRoot.next;
  172.           prev:= ADR (LRoot);
  173.           owner:= list.root;
  174.           level:= lev;
  175.         END;
  176.         LRoot.next^.prev:= p;
  177.         LRoot.next:= p;
  178.         WITH list.root^ DO
  179.           prev:= list.root;
  180.           next:= list.root;
  181.           data:= p
  182.         END;
  183.       *)
  184.       ASSEMBLER
  185.         MOVE.L  p(A6),A0
  186.         LEA     LRoot,A1
  187.         MOVE.L  list(A6),A2
  188.         MOVE.L  Control.next(A1),Control.next(A0)
  189.         MOVE.L  A1,Control.prev(A0)
  190.         MOVE.L  List.root(A2),Control.owner(A0)
  191.         MOVE.W  lev(A6),Control.level(A0)
  192.         MOVE.L  A0,D0
  193.         MOVE.L  Control.next(A1),A0
  194.         MOVE.L  D0,Control.prev(A0)
  195.         MOVE.L  D0,Control.next(A1)
  196.         MOVE.L  List.root(A2),A0
  197.         MOVE.L  A0,Carrier.next(A0)
  198.         MOVE.L  A0,Carrier.prev(A0)
  199.         MOVE.L  D0,Carrier.data(A0)
  200.       END
  201.     END;
  202.     ResetList (list)
  203.   END create;
  204.  
  205. PROCEDURE CreateList ( VAR list: List; VAR error: BOOLEAN );
  206.   (*$L-*)
  207.   BEGIN
  208.     ASSEMBLER
  209.         ;create (list,error,Level)
  210.         MOVE    Level,(A3)+
  211.         JMP     create
  212.     END
  213.   END CreateList;
  214.   (*$L=*)
  215.  
  216. PROCEDURE SysCreateList ( VAR list: List; VAR error: BOOLEAN );
  217.   (*$L-*)
  218.   BEGIN
  219.     ASSEMBLER
  220.         ;create (list,error,-1)
  221.         MOVE    #-1,(A3)+
  222.         JMP     create
  223.     END
  224.   END SysCreateList;
  225.   (*$L=*)
  226.  
  227. PROCEDURE ListEmpty (VAR list:List): BOOLEAN;
  228.   (*$L-*)
  229.   BEGIN
  230.     (* WITH list DO
  231.          RETURN (root=NIL) OR ( (root^.next=root) & (root^.prev=root) ) *)
  232.     ASSEMBLER
  233.         MOVE.L  -(A3),A0        ; list
  234.         MOVE.L  List.root(A0),D0
  235.         BEQ     T
  236.         MOVE.L  D0,A1
  237.         CMPA.L  Carrier.next(A1),A1
  238.         BNE     F
  239.         CMPA.L  Carrier.prev(A1),A1
  240.         BNE     F
  241.      T: MOVE    #1,(A3)+
  242.         RTS
  243.      F: CLR     (A3)+
  244.     END
  245.   END ListEmpty;
  246.   (*$L=*)
  247.  
  248. PROCEDURE DeleteList ( VAR list: List; VAR error: BOOLEAN );
  249.   VAR p:P_Control;
  250.   BEGIN
  251.     error:= ~ListEmpty (list);
  252.     IF ~error THEN
  253.       WITH list DO
  254.         IF root#NIL THEN
  255.           p:= root^.data;
  256.           WITH p^ DO
  257.             prev^.next:= next;
  258.             next^.prev:= prev
  259.           END;
  260.           DISPOSE (p);
  261.           DISPOSE (root)
  262.         END
  263.       END
  264.     END
  265.   END DeleteList;
  266.  
  267.  
  268. PROCEDURE InsertEntry ( VAR list: List; entry: ADDRESS; VAR error: BOOLEAN );
  269.   VAR p:LCarrier;
  270.   BEGIN
  271.     (* WITH list DO *)
  272.     IF list.root=NIL THEN
  273.       error:= TRUE
  274.     ELSE
  275.       SysAlloc (p,SIZE (p^));
  276.       (*
  277.         error:= (p=NIL);
  278.         IF ~error THEN
  279.           p^.next:= current^.next;
  280.           p^.prev:= current;
  281.           p^.data:= entry;
  282.           WITH current^ DO
  283.             next^.prev:= p;
  284.             next:= p
  285.           END;
  286.           current:= p
  287.         END
  288.       *)
  289.       ASSEMBLER
  290.         MOVE.L  error(A6),A1
  291.         MOVE.L  p(A6),D0
  292.         BEQ     ERR
  293.         
  294.         CLR     (A1)
  295.         MOVE.L  D0,A1           ; p: A1
  296.         MOVE.L  list(A6),A0     ; list: A0
  297.         MOVE.L  List.current(A0),A2
  298.         MOVE.L  Carrier.next(A2),A0     ; current^.next
  299.         MOVE.L  A0,Carrier.next(A1)
  300.         MOVE.L  A2,Carrier.prev(A1)
  301.         MOVE.L  entry(A6),Carrier.data(A1)
  302.         
  303.         MOVE.L  A1,Carrier.prev(A0)
  304.         MOVE.L  A1,Carrier.next(A2)
  305.         MOVE.L  list(A6),A0
  306.         MOVE.L  A1,List.current(A0)
  307.         BRA     CONT
  308.         
  309.       ERR:
  310.         MOVE    #1,(A1)
  311.       CONT:
  312.       END
  313.     END
  314.   END InsertEntry;
  315.  
  316. PROCEDURE AppendEntry ( VAR list: List; entry: ADDRESS; VAR error: BOOLEAN );
  317.   VAR p:LCarrier;
  318.   BEGIN
  319.     (*WITH list DO*)
  320.     IF list.root=NIL THEN
  321.       error:= TRUE
  322.     ELSE
  323.       SysAlloc (p,SIZE (p^));
  324.       (*
  325.         error:= (p=NIL);
  326.         IF ~error THEN
  327.           p^.prev:= root^.prev;
  328.           p^.next:= root;
  329.           p^.data:= entry;
  330.           WITH root^ DO
  331.             prev^.next:= p;
  332.             prev:= p
  333.           END;
  334.         END
  335.       *)
  336.       ASSEMBLER
  337.         MOVE.L  error(A6),A1
  338.         MOVE.L  p(A6),D0
  339.         BEQ     ERR
  340.         
  341.         CLR     (A1)
  342.         MOVE.L  D0,A1           ; p: A1
  343.         MOVE.L  list(A6),A0     ; list: A0
  344.         MOVE.L  List.root(A0),A2
  345.         MOVE.L  Carrier.prev(A2),A0     ; root^.prev
  346.         MOVE.L  A0,Carrier.prev(A1)
  347.         MOVE.L  A2,Carrier.next(A1)
  348.         MOVE.L  entry(A6),Carrier.data(A1)
  349.         
  350.         MOVE.L  A1,Carrier.next(A0)
  351.         MOVE.L  A1,Carrier.prev(A2)
  352.         BRA     CONT
  353.         
  354.       ERR:
  355.         MOVE    #1,(A1)
  356.       CONT:
  357.       END
  358.     END
  359.   END AppendEntry;
  360.  
  361. PROCEDURE RemoveEntry ( VAR list: List; VAR error: BOOLEAN );
  362.   (*$L-*)
  363.   BEGIN
  364.     (*
  365.       VAR p:LCarrier;
  366.       WITH list DO
  367.         error := (root=NIL) OR (current=root);
  368.         IF ~error THEN
  369.           p:= current;
  370.           current:= current^.prev;
  371.           WITH p^ DO
  372.             next^.prev:= prev;
  373.             prev^.next:= next
  374.           END;
  375.           DISPOSE (p)
  376.         END
  377.       END
  378.     *)
  379.     ASSEMBLER
  380.         MOVE.L  -(A3),A1
  381.         MOVE.L  -(A3),A0
  382.         MOVE.L  List.root(A0),D0
  383.         BEQ     err
  384.         MOVE.L  List.current(A0),A2
  385.         CMP.L   A2,D0
  386.         BEQ     err
  387.         
  388.         CLR     (A1)
  389.         MOVE.L  Carrier.prev(A2),List.current(A0)
  390.         MOVE.L  Carrier.next(A2),A1
  391.         MOVE.L  Carrier.prev(A2),A0
  392.         MOVE.L  A0,Carrier.prev(A1)
  393.         MOVE.L  A1,Carrier.next(A0)
  394.         
  395.         MOVE.L  A2,-(A7)
  396.         MOVE.L  A7,(A3)+
  397.         CLR.L   (A3)+
  398.         JSR     DEALLOCATE
  399.         ADDQ.L  #4,A7
  400.         RTS
  401.         
  402.       err:
  403.         MOVE    #1,(A1)
  404.     END
  405.   END RemoveEntry;
  406.   (*$L=*)
  407.  
  408. PROCEDURE NextEntry ( VAR list: List ): ADDRESS;
  409.   (*$L-*)
  410.   BEGIN
  411.     (*
  412.       WITH list DO
  413.         IF current#NIL THEN
  414.           current:= current^.next;
  415.           IF current=root THEN
  416.             RETURN NIL
  417.           ELSE
  418.             RETURN current^.data
  419.           END
  420.         ELSE
  421.           RETURN NIL
  422.         END
  423.       END
  424.     *)
  425.     ASSEMBLER
  426.         MOVE.L  -(A3),A0
  427.         MOVE.L  List.current(A0),D0
  428.         BEQ     ende
  429.         MOVE.L  D0,A1
  430.         MOVE.L  Carrier.next(A1),A2
  431.         MOVE.L  A2,List.current(A0)
  432.         MOVEQ   #0,D0
  433.         CMPA.L  List.root(A0),A2
  434.         BEQ     ende
  435.         MOVE.L  Carrier.data(A2),D0
  436.       ende:
  437.         MOVE.L  D0,(A3)+
  438.     END
  439.   END NextEntry;
  440.   (*$L=*)
  441.  
  442. PROCEDURE PrevEntry ( VAR list: List ): ADDRESS;
  443.   (*$L-*)
  444.   BEGIN
  445.     (*
  446.       WITH list DO
  447.         IF current#NIL THEN
  448.           current:= current^.prev;
  449.           IF current=root THEN
  450.             RETURN NIL
  451.           ELSE
  452.             RETURN current^.data
  453.           END
  454.         ELSE
  455.           RETURN NIL
  456.         END
  457.       END
  458.     *)
  459.     ASSEMBLER
  460.         MOVE.L  -(A3),A0
  461.         MOVE.L  List.current(A0),D0
  462.         BEQ     ende
  463.         MOVE.L  D0,A1
  464.         MOVE.L  Carrier.prev(A1),A2
  465.         MOVE.L  A2,List.current(A0)
  466.         MOVEQ   #0,D0
  467.         CMPA.L  List.root(A0),A2
  468.         BEQ     ende
  469.         MOVE.L  Carrier.data(A2),D0
  470.       ende:
  471.         MOVE.L  D0,(A3)+
  472.     END
  473.   END PrevEntry;
  474.   (*$L=*)
  475.  
  476. PROCEDURE CurrentEntry ( VAR list: List ): ADDRESS;
  477.   (*$L-*)
  478.   BEGIN
  479.     (*
  480.       WITH list DO
  481.         IF (current=NIL) OR(current=root) THEN
  482.           RETURN NIL
  483.         ELSE
  484.           RETURN current^.data
  485.         END
  486.       END
  487.     *)
  488.     ASSEMBLER
  489.         MOVE.L  -(A3),A0
  490.         MOVE.L  List.current(A0),D0
  491.         BEQ     ende
  492.         MOVE.L  D0,A2
  493.         MOVEQ   #0,D0
  494.         CMPA.L  List.root(A0),A2
  495.         BEQ     ende
  496.         MOVE.L  Carrier.data(A2),D0
  497.       ende:
  498.         MOVE.L  D0,(A3)+
  499.     END
  500.   END CurrentEntry;
  501.   (*$L=*)
  502.  
  503. PROCEDURE FindEntry ( VAR list: List; entry: ADDRESS; VAR found: BOOLEAN );
  504.   (*$L-*)
  505.     (*VAR scan:LCarrier;*)
  506.   BEGIN
  507.     (*
  508.       found:= FALSE;
  509.       IF list.root#NIL THEN
  510.         scan:= list.root^.next;
  511.         WHILE scan#list.root DO
  512.           IF scan^.data=entry THEN found:= TRUE; list.current:= scan; RETURN END;
  513.           scan:= scan^.next
  514.         END
  515.       END
  516.     *)
  517.     ASSEMBLER
  518.         MOVE.L  -(A3),A2
  519.         CLR     (A2)                    ; A2: found
  520.         MOVE.L  -(A3),D2                ; D2: entry
  521.         MOVE.L  -(A3),A0                ; A0: list
  522.         
  523.         MOVE.L  List.root(A0),D1
  524.         BEQ     ende
  525.         
  526.         MOVE.L  D1,A1                   ; A1: scan
  527.       lup:
  528.         MOVE.L  Carrier.next(A1),A1
  529.         CMP.L   A1,D1
  530.         BEQ     ende
  531.         CMP.L   Carrier.data(A1),D2
  532.         BNE     lup
  533.         
  534.         MOVE    #1,(A2)
  535.         MOVE.L  A1,List.current(A0)
  536.         
  537.       ende:
  538.     END
  539.   END FindEntry;
  540.   (*$L=*)
  541.  
  542. PROCEDURE scanFrwd ( VAR list: List; cond: LCondProc; info:ADDRESS;
  543.                      VAR found: BOOLEAN );
  544.   BEGIN
  545.     WITH list DO
  546.       IF current#NIL THEN
  547.         LOOP
  548.           current:= current^.next;
  549.           IF current=root THEN EXIT END;
  550.           IF cond (current^.data,info) THEN
  551.             found:= TRUE;
  552.             EXIT
  553.           END
  554.         END
  555.       END
  556.     END
  557.   END scanFrwd;
  558.  
  559. PROCEDURE scanBack ( VAR list: List; cond: LCondProc; info:ADDRESS;
  560.                      VAR found: BOOLEAN );
  561.   BEGIN
  562.     WITH list DO
  563.       IF current#NIL THEN
  564.         LOOP
  565.           current:= current^.prev;
  566.           IF current=root THEN EXIT END;
  567.           IF cond (current^.data,info) THEN
  568.             found:= TRUE;
  569.             RETURN
  570.           END
  571.         END
  572.       END
  573.     END
  574.   END scanBack;
  575.  
  576. PROCEDURE ScanEntries ( VAR list: List; dir: LDir; cond: LCondProc;
  577.                         info:ADDRESS; VAR found: BOOLEAN );
  578.   VAR scan:LCarrier;
  579.   BEGIN
  580.     found:= FALSE;
  581.     IF dir=forward THEN
  582.       scanFrwd (list,cond,info,found)
  583.     ELSE
  584.       scanBack (list,cond,info,found)
  585.     END
  586.   END ScanEntries;
  587.  
  588. PROCEDURE EndOfList ( VAR list: List ): BOOLEAN;
  589.   (*$L-*)
  590.   BEGIN
  591.     (*
  592.       WITH list DO
  593.         RETURN (current=root) OR (root=NIL)
  594.       END
  595.     *)
  596.     ASSEMBLER
  597.         MOVE.L  -(A3),A0
  598.         MOVE.L  List.root(A0),D0
  599.         BEQ     ende
  600.         MOVE.L  D0,D1
  601.         MOVEQ   #0,D0
  602.         CMP.L   List.current(A0),D1
  603.         BEQ     ende
  604.         MOVEQ   #1,D0
  605.       ende:
  606.         EORI    #1,D0
  607.         MOVE    D0,(A3)+
  608.     END
  609.   END EndOfList;
  610.   (*$L=*)
  611.  
  612. PROCEDURE FirstEntry ( VAR list: List ): BOOLEAN;
  613.   (*$L-*)
  614.   BEGIN
  615.     (* WITH list DO
  616.          RETURN (current^.prev=root) OR (root=NIL)
  617.     *)
  618.     ASSEMBLER
  619.         MOVE.L  -(A3),A0
  620.         MOVE.L  List.root(A0),D0
  621.         BEQ     ende
  622.         MOVE.L  D0,D1
  623.         MOVE.L  List.current(A0),D0
  624.         BEQ     ende
  625.         MOVE.L  D0,A2
  626.         MOVEQ   #0,D0
  627.         CMP.L   Carrier.prev(A2),D1
  628.         BEQ     ende
  629.         MOVEQ   #1,D0
  630.       ende:
  631.         EORI    #1,D0
  632.         MOVE    D0,(A3)+
  633.     END
  634.   END FirstEntry;
  635.   (*$L=*)
  636.  
  637. PROCEDURE LastEntry ( VAR list: List ): BOOLEAN;
  638.   (*$L-*)
  639.   BEGIN
  640.     (* WITH list DO
  641.          RETURN (current^.next=root) OR (root=NIL)
  642.     *)
  643.     ASSEMBLER
  644.         MOVE.L  -(A3),A0
  645.         MOVE.L  List.root(A0),D0
  646.         BEQ     ende
  647.         MOVE.L  D0,D1
  648.         MOVE.L  List.current(A0),D0
  649.         BEQ     ende
  650.         MOVE.L  D0,A2
  651.         MOVEQ   #0,D0
  652.         CMP.L   Carrier.next(A2),D1
  653.         BEQ     ende
  654.         MOVEQ   #1,D0
  655.       ende:
  656.         EORI    #1,D0
  657.         MOVE    D0,(A3)+
  658.     END
  659.   END LastEntry;
  660.   (*$L=*)
  661.  
  662. PROCEDURE NoOfEntries ( VAR list: List ): CARDINAL;
  663.   (*$L-*)
  664.     (*VAR n:CARDINAL; scan:LCarrier;*)
  665.   BEGIN
  666.     (*
  667.       n:= 0;
  668.       IF list.root#NIL THEN
  669.         scan:= list.root^.next;
  670.         WHILE scan#list.root DO
  671.           INC (n);
  672.           scan:= scan^.next
  673.         END
  674.       END;
  675.       RETURN n
  676.     *)
  677.     ASSEMBLER
  678.         CLR     D0              ; n
  679.         MOVE.L  -(A3),A0
  680.         MOVE.L  List.root(A0),D1
  681.         BEQ     ende
  682.         
  683.         MOVE.L  D1,A1                   ; A1: scan
  684.       lup:
  685.         MOVE.L  Carrier.next(A1),A1
  686.         CMP.L   A1,D1
  687.         BEQ     ende
  688.         ADDQ    #1,D0
  689.         BNE     lup
  690.         TRAP    #6
  691.         DC.W    MOSGlobals.Overflow-$4000  ; callerCaused
  692.       ende:
  693.         MOVE    D0,(A3)+
  694.     END
  695.   END NoOfEntries;
  696.   (*$L=*)
  697.  
  698.  
  699. PROCEDURE releaseLevel;
  700.   VAR p:P_Control; ent: ADDRESS; del, err: BOOLEAN; li: List;
  701.   BEGIN
  702.     p:= ADR (LRoot);
  703.     p:= p^.next;
  704.     WHILE p # ADR (LRoot) DO
  705.       del:= p^.level>=Level;
  706.       li.root:= p^.owner;
  707.       p:= p^.next;
  708.       IF del THEN
  709.         ResetList (li);
  710.         ent:= PrevEntry (li);
  711.         REPEAT
  712.           RemoveEntry (li,err)  (* Alle Entries löschen *)
  713.         UNTIL err;
  714.         DeleteList (li,err)  (* Nun Liste freigeben *)
  715.       END
  716.     END
  717.   END releaseLevel;
  718.  
  719. PROCEDURE chgLevel (start:BOOLEAN; inChild:BOOLEAN; VAR exitCode:INTEGER);
  720.   BEGIN
  721.     IF inChild THEN
  722.       IF start THEN
  723.         INC (Level)
  724.       ELSE
  725.         releaseLevel;
  726.         DEC (Level)
  727.       END
  728.     END
  729.   END chgLevel;
  730.  
  731. PROCEDURE freeSys;
  732.   BEGIN
  733.     Level:= MinInt;
  734.     releaseLevel
  735.   END freeSys;
  736.  
  737. VAR eHdl: PrgCtrl.EnvlpCarrier;
  738.     tHdl: PrgCtrl.TermCarrier;
  739.     rHdl: RemovalCarrier;
  740.     wsp: MOSGlobals.MemArea;
  741.  
  742. BEGIN
  743.   Level:= 0;
  744.   LRoot.prev:= ADR (LRoot);
  745.   LRoot.next:= ADR (LRoot);
  746.   wsp.bottom:= NIL;
  747.   PrgCtrl.SetEnvelope (eHdl,chgLevel,wsp);
  748.   PrgCtrl.CatchProcessTerm (tHdl,releaseLevel,wsp);
  749.   CatchRemoval (rHdl,freeSys,wsp);
  750. END Lists.
  751. ə
  752. (* $00001249$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$0000451A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFF8B082$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016A$FFFB016AÇ$00000038T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$00000D02$00000082$0000002F$00000496$00000742$00000038$00000DCF$00000DB9$00000DA8$00000D9C$00000DA8$00000D41$0000022E$00000082$000001D3$00000855ÿÇü*)
  753.